Packard Bell - Internet on a CD/internet on a cd.cdr/Internet/sites/Clementine_NASA/image.hqx/Image folder/Macros/Measurement Macros

Text File | 1991-08-01 | 4.2 KB | 205 lines

macro 'Display Calibration Table';
{
Stores 0-255(all possible raw pixel values) in the Area column
and the 256 corresponding calibrated values in the Mean column.
Max Measurements must be set to 256 or greater. Use the Export
command to export the calibration table to a text file. The two
columns will be identical if the image has not been calibrated
using the Calibrate command.
}
var
  i:integer;
  v:real;
begin
  SetCounter(256); {SetCounter new in V1.41}
  for i:=0 to 255 do begin
    rArea[i+1]:=i;
    rMean[i+1]:=cvalue(i);
  end;
  ShowResults;
  Export;
end;


macro 'Measure and draw line [L]';
var
  x1,x2,y1,y2,width:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a line selection.');
    exit;
  end;
  Measure;
  Fill;
  KillRoi;
end;


macro 'Measure All';
{Measures all currently open images using the current selection. There is}
{an implied "Select All" if the active image doesn't have a selection.}
var
  i,left,top,width,height:integer;
begin
  ResetCounters;
  for i:=1 to nPics do begin
    SelectPic(i);
    RestoreROI;
    Measure;
  end;
end;


macro 'Measure All from Disk';
{
Reads from disk and measures a set of images too large to simultaneously
fit in memory. The image names names must be in the form '01', '02', etc.
Before starting, open and outline the first image('01').
}
var
  i,width,height:integer;
begin
  GetPicSize(width,height);
  if width=0 then begin
    PutMessage('Before running this macro, open and outline the first image("01") in the series.');
    exit;
  end;
  ResetCounters;
  Measure;
  close;
  for i:=2 to 1000 do begin
    open(i:2);
    RestoreROI;
    Measure;
    close;
  end;
end;


macro 'Paste Results [P]'
{Use the Measure command, the ruler tool, or the pointing tool to}
{make up to about 10 measurements, then use this macro to paste}
{the results into the upper left corner of the window.}
begin
  SetFont('Monaco');
  SetFontSize(9);
  SetText('Plain; Align Left');
  SetOption; {Copy headings}
  CopyResults;
  MakeRoi(-10,0,250,150);
  Paste;
  KillRoi;
  ResetCounters;
end;


macro 'Measure Redirected and Label'
begin
  Redirect(true);
  Measure;
  Redirect(false);
  MarkSelection;
  RestoreRoi;
end;


macro 'Reset Analysis Options';
{Resets the Options dialog box in the Analyze menu to the default settings.}
begin
  MeasureArea(true);
  MeasureDensity(true);
  MeasureStandardDeviation(false);
  MeasureXY(false);
  MeasureMode(false);
  MeasurePerimeter(false);
  MeasureMajorAxis(false);
  MeasureMinorAxis(false);
  MeasureAngle(false);
  MeasureIntegratedDensity(false);
  Redirect(false);
  LabelParticles(true);
  OutlineParticles(false);
  IgnoreParticlesTouchingEdge(false);
  IncludeInteriorHoles(false);
  WandAutoMeasure(false);
  AdjustAreas(false);
  SetParticleSize(1,999999);
  SetPrecision(2);
end;


macro 'Set Threshold';
var
  lower,upper:integer;
begin
  lower:=GetNumber('Lower:',1);
  upper:=GetNumber('Upper:',254);
  SetDensitySlice(lower,upper);
end;


macro 'Measure Accumulated Perimeter[A]';
{
Measures perimeter and computes accumulated perimeter,
storing it in the Major Axis column.
}
var
  i:integer;
  TotalPerimeter:real;
begin
  MeasurePerimter(true);
  SetMajorLabel('Total');
  Measure;
  TotalPerimeter:=0;
  for i:=1 to rCount do TotalPerimeter:=TotalPerimeter+rLength[i];
  rMajor[rCount]:=TotalPerimeter;
  UpdateResults;
end;

macro 'Count Black and White Pixels [B]';
{
Counts the number of black and white pixels in the current
selection and stores the counts in the Major and Minor Axis columns.
}
begin
  SetMajorLabel('Black');
  SetMinorLabel('White');
  Measure;
  rMajor[rCount]:=histogram[255];
  rMinor[rCount]:=histogram[0];
  UpdateResults;
end;


macro 'Compute Average and Total Area [T]';
{
Computes average and accumulated area and stores
the them in the Major and Minor Axis columns.
}
var
  i:integer;
  TotalArea:real;
begin
  SetMajorLabel('Average');
  SetMinorLabel('Total');
  Measure;
  TotalArea:=0;
  for i:=1 to rCount do TotalArea:=TotalArea+rArea[i];
  rMajor[rCount]:=TotalArea/rCount;;
  rMinor[rCount]:=TotalArea;
  UpdateResults;
end;


macro 'Measure Circularity [C]';
begin
  SetMajorLabel('Shape');
  Measure;
  rMajor[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount]));
  UpdateResults;
end;